home *** CD-ROM | disk | FTP | other *** search
/ Amiga Collections: Franz PD / Franz PD Disk #193 (1992)(Rhein-Sieg-Soft).zip / Franz PD Disk #193 (1992)(Rhein-Sieg-Soft).adf / GFA.Anwendung / Verkehrstest_V1.00c.LST < prev    next >
File List  |  1992-09-14  |  23KB  |  620 lines
  1. ' ***********************************************
  2. ' *                                             *
  3. ' *  Verkehrstest V 1.00c   © 29.9.1991 by      *
  4. ' *                                             *
  5. ' * Henry König, Bornheide 71, 2000 Hamburg 53  *
  6. ' *                                             *
  7. ' ***********************************************
  8. RESERVE 100000
  9. init                            ! Variablen initialisieren
  10. ON MENU BUTTON GOSUB mauskontrolle
  11. start:                          ! Sprungmarke der Fehlerroutine
  12. REPEAT                          ! Warteschleife für die Mauskontrolle
  13.   SLEEP
  14. UNTIL ende!
  15. CLOSES 1                        ! Bildschirm schließen
  16. CLOSEW #1                       ! Fenster schließen
  17. END                             ! Ende
  18. PROCEDURE anweisung(aw%)
  19.   PRINT AT(4,ax%(aw%));SPACE$(74) ! Zeile löschen
  20.   PRINT AT(ay%(aw%),ax%(aw%));aw$(aw%) ! Anweisung ausgeben
  21. RETURN
  22. PROCEDURE auswertung            ! Antworten ausgeben
  23.   IF aw%(1)=zahl%(1) THEN
  24.     PCOLOR 6
  25.   ELSE
  26.     PCOLOR 3
  27.     berechnung%=1
  28.   ENDIF
  29.   PRINT AT(10,9);anw$(0)
  30.   PRINT AT(10,10);anw$(1)
  31.   IF aw%(2)=zahl%(2) THEN
  32.     PCOLOR 6
  33.   ELSE
  34.     PCOLOR 3
  35.     berechnung%=1
  36.   ENDIF
  37.   PRINT AT(10,12);anw$(2)
  38.   PRINT AT(10,13);anw$(3)
  39.   IF aw%(3)=zahl%(3) THEN
  40.     PCOLOR 6
  41.   ELSE
  42.     PCOLOR 3
  43.     berechnung%=1
  44.   ENDIF
  45.   PRINT AT(10,15);anw$(4)
  46.   PRINT AT(10,16);anw$(5)
  47.   IF berechnung%=1 THEN
  48.     fehlerpunkte%=fehlerpunkte%+fehler%
  49.     berechnung%=0
  50.   ENDIF
  51.   IF aw%(1)=zahl%(1) AND aw%(2)=zahl%(2) AND aw%(3)=zahl%(3) THEN
  52.     hilf%(z%)=1
  53.     i%=i%-1
  54.   ENDIF
  55.   tastendruck1                   ! auf Tastendruck oder Mausklick warten
  56.   FOR j%=1 TO 3
  57.     aw%(j%)=0
  58.     g%(j%)=1
  59.   NEXT j%
  60.   IF fehlerpunkte%>8 OR i%<=1 THEN
  61.     testergebniss
  62.     GOTO auswertung.ende
  63.   ENDIF
  64.   i%=i%-1                       ! Fragenzähler minus 1
  65.   naechste:                     ! nächste Frage bestimmen
  66.   z%=1+RAND(n%)                 ! Nummer der Frage per Zufall bestimmen
  67.   IF fraz%>=30 THEN             ! Fragebogen hat 30 Fragen
  68.     testergebniss
  69.     GOTO auswertung.ende
  70.   ENDIF
  71.   z%=z%-1                       ! Nummer der Frage minus 1
  72.   IF z%>i% THEN
  73.     z%=1
  74.   ENDIF
  75.   IF z%<=1 THEN
  76.     i%=n%                       ! Anzahl der Fragen
  77.     z%=1+RAND(n%)               ! Nummer der Frage per Zufall bestimmen
  78.   ENDIF
  79.   IF hilf%(z%)=0 THEN
  80.     frage.stellen               ! nächste Frage stellen
  81.     GOTO auswertung.ende
  82.   ELSE
  83.     i%=n%                       ! Anzahl der Fragen
  84.     GOTO naechste
  85.   ENDIF
  86.   auswertung.ende:
  87. RETURN
  88. PROCEDURE beenden               ! Programm beenden
  89.   ALERT 0,"Wollen Sie aufhören",1,"Ende|Weiter",wahl%
  90.   ende!=(wahl%=1)
  91. RETURN
  92. PROCEDURE cursor.aus
  93.   LOCATE spalte%+sp%,zeile%     ! Cursor positionieren
  94.   textstil(0,1,0)               ! Invers ausschalten
  95.   PRINT MID$(t$,sp%,1)          ! Zeichen ausgeben
  96. RETURN
  97. PROCEDURE daten                 ! Daten für Menüs und Anweisungen
  98.   DATA 31, 5,"Variable Anweisung",0
  99.   DATA 28,12,"",1
  100.   DATA 28,30,"Sind Sie sicher",2
  101.   DATA 28,22,"Sind alle Angaben richtig",3
  102.   DATA 31, 6,"",4
  103.   DATA 31,24,"",5
  104.   DATA 2,  4,"",6
  105.   DATA 28,25,"",7
  106.   DATA 28, 4,"",8
  107.   DATA 31,10,"",9
  108.   DATA 31, 4,"Feldposition im Druck ändern. Reihenfolge eingeben. 0 = nicht Ausgeben.",10
  109.   DATA 31,14,"Eingabefelder mit | markieren. Masken-Editor mit Esc beenden",11
  110.   DATA 31,18,"Bitte ewas Geduld. Die Maske wird überprüft.",12
  111.   DATA 28,20,"Fehler in der Maske. Korrigieren",13
  112.   DATA 31, 4,"Dateneingabe oder Datenänderung können Sie nur mit der 'Esc'-Taste beenden.",14
  113.   DATA 31, 4,"Index-(Sortier)Felder durch Ziffern (1 -)an und bestätigen die Eingabe mit Esc.",15
  114.   DATA 31, 8,"Unterbrechung mit beliebiger Taste, Abbruch mit der « Esc-Taste » ",16
  115.   DATA 31, 4,"Bei RETURN wird jedes Datenfeld übernommen, sonst wird selektiert.",17
  116.   DATA 31, 4,"Anwahl = linke Maustaste, Cursor, Buchst. Start = rechte Maustaste, RETURN",18
  117.   DATA 28,10,"Soll die Konfiguratiom gespeichert werden",19
  118.   DATA 31, 4,"",20
  119.   DATA 28,10,"Fragen-Datei 'Verkehr.Daten' oder 'Verkehr.Maske' auswählen.",21
  120.   DATA 28, 4,"",22
  121.   DATA 28,13,"Soll die neue Datei auf Festplatte",23
  122.   DATA 28,20,"Datenfeld mehrfach gewählt. Korrigieren",24
  123.   DATA 28,10,"Ausgabefelder (Reihenfolge) ändern oder unterdrücken",25
  124.   DATA 28, 4,"Sie haben die Maske verändert. Datei neu organisieren",26
  125.   DATA 31,10,"V e r k e h r s t e s t  V1.00c  © 29.9.1991 by Henry König",27
  126.   DATA 31,10,"Der interne Speicher ist voll. Weiter mit beliebiger Taste",28
  127.   DATA 28, 4,"Achtung es sind Vorgabeflags gesetzt. Vorgabe berücksichtigen",29
  128.   DATA 31, 4,"= ersetzen, <> entfernen, < voranstellen, > anfügen, * Instring",30
  129.   DATA 28,14,"Soll dieser Datensatz verändert werden",31
  130.   DATA 22,20,"Übernommenen Datensatz ergänzen",32
  131.   DATA 31, 4,"Ordner sind mit '*' gekennzeichet. Zum Ordnerwechsel nur einmal klicken.",33
  132.   DATA 28, 4,"Auswertung in neue Datei (J), an vorhandene Datei anhängen (N)",34
  133.   DATA 28, 4,"Druckzeile ist zu lang. Druckersteuerung durchs Programm",35
  134.   DATA 28, 4,"Speichermangel. Zusätzliche Indexfelder entfernen",36
  135. RETURN
  136. PROCEDURE eingabe(sp%,zeile%,spalte%,lg%,t$)
  137.   undo1$=t$                     ! Eingabe sichern
  138.   eingabe0:
  139.   PRINT AT(spalte%+1,zeile%);t$ ! String auf Bildschirm
  140.   eingabe1:
  141.   IF sp%<1 THEN                 ! Spalte < 1
  142.     sp%=1                       ! ja, dann Spalte = 1
  143.   ELSE IF sp%>lg%               ! Spalte > Stringlaenge
  144.     sp%=lg%                     ! ja, dann Spalte = Stringlaenge
  145.   ENDIF
  146.   LOCATE spalte%+sp%,zeile%     ! Cursor positionieren
  147.   textstil(7,3,6)               ! Invers an
  148.   PRINT MID$(t$,sp%,1)          ! Zeichen ausgeben
  149.   textstil(0,1,0)               ! Invers aus
  150.   taste                         ! Zeichen von Tastatur holen
  151.   IF mausy%>0 THEN              ! mit Maus positioniert
  152.     cursor.aus                  ! Ersatz-Cursor aus
  153.     IF (cf% AND mausy%<>zeile%) OR (cf% AND mausx%<spalte%) OR (cf% AND mausx%>spalte%+lg%) THEN
  154.       GOTO eingabe.ende         ! ja, dann Ende
  155.     ELSE
  156.       sp%=mausx%-spalte%        ! Spaltenposition = Mausspalte-Spalte
  157.     ENDIF
  158.   ENDIF
  159.   IF cf%=1 THEN                 ! Datenfeld links/rechts
  160.     IF x%=12 OR x%=18 OR x%=20 OR x%=22 THEN      !
  161.       GOTO eingabe.ende
  162.     ENDIF
  163.   ENDIF
  164.   IF x%=13 OR x%=27 THEN        ! Abbbruch durch Esc oder RETURN?
  165.     GOTO eingabe.ende
  166.   ELSE IF x%=155                ! Sondertasten
  167.     x%=ASC(MID$(x$,2,1))        ! ASCII-Wert
  168.     cursor.aus                  ! Ersatz-Cursor ausschalten
  169.     IF x%=65 AND cf%=1 OR x%=66 AND cf%=1 THEN ! Abbbruch
  170.       GOTO eingabe.ende
  171.     ENDIF
  172.     IF x%=63 THEN               ! HELP-Taste
  173.     ELSE IF x%=67               ! Cursor rechts
  174.       INC sp%                   ! ja, dann Spalte +1
  175.     ELSE IF x%=68               ! Cursor links
  176.       DEC sp%                   ! ja, dann Spalte -1
  177.     ELSE IF x%=90               ! TAB links
  178.       sp%=sp%-8                 ! Spalte -8
  179.     ENDIF
  180.   ELSE IF x%=127                !   Delete
  181.     t$=LEFT$(t$,sp%-1)+MID$(t$,sp%+1,lg%-sp%)+" " ! Zeichen löschen
  182.   ELSE IF x%<32 OR x%>127 AND x%<160  ! Steuerzeichen?
  183.     cursor.aus
  184.     IF x%=8 AND sp%>1 THEN      ! Backspace
  185.       t$=LEFT$(t$,sp%-2)+MID$(t$,sp%,lg%-sp%+1)+" " ! Leerzeichen einfügen
  186.       sp%=sp%-1                 ! Spalte -1
  187.     ELSE IF x%=4                ! Ctrl-d
  188.       t$=SPACE$(lg%)            ! ja, dann String löschen
  189.     ELSE IF x%=9                ! TAB rechts
  190.       sp%=sp%+8                 ! ja, dann Spalte +8
  191.     ELSE IF x%=16               ! Crtl-p
  192.       auto.insert%=NOT auto.insert% ! ja, dann Insertflag ändern
  193.       CLR x%                    ! Steuerzeichen löschen
  194.       IF auto.insert%=0 THEN
  195.         PRINT AT(2,29);"Insert aus"
  196.       ELSE
  197.         PRINT AT(2,29);"Insert an "
  198.       ENDIF
  199.     ELSE IF x%=21               ! Ctrl-u = Feld einfügen
  200.       t$=LEFT$(undo$+SPACE$(lg%),lg%) ! Text aus Puffer auf Sollänge bringen
  201.     ELSE IF x%=25               ! Ctrl-y = Feld löschen
  202.       undo$=t$                  ! Text zwischenspeichern
  203.       t$=SPACE$(lg%)            ! String löschen
  204.       sp%=1                     ! Spalte = 1
  205.     ENDIF
  206.   ELSE                          ! gültiges ASCII-Zeichen übernehmen
  207.     IF auto.insert% THEN        ! Einfügemodus eingeschaltet?
  208.       t$=LEFT$(t$,sp%-1)+x$+MID$(t$,sp%,lg%-sp%) ! ja, dann Zeichen einfügen
  209.     ELSE                        ! Überschreibmodus
  210.       MID$(t$,sp%,1)=x$         ! Zeichen überschreiben
  211.     ENDIF
  212.     INC sp%                     ! Spalte +1
  213.   ENDIF
  214.   GOTO eingabe0
  215.   eingabe.ende:
  216.   cursor.aus                    ! Ersatz-Cursor ausschalten
  217.   tx$=t$                        ! Rückgabestring an die aufrufende Procedure
  218.   sp1%=sp%
  219. RETURN
  220. PROCEDURE farben.setzen
  221.   SETCOLOR 0,5,5,5              ! grau statt blau
  222.   SETCOLOR 1,15,15,15           ! weiß bleibt
  223.   SETCOLOR 2,0,0,0              ! schwarz erhalten
  224.   SETCOLOR 3,15,5,0             ! rot bleibt
  225.   SETCOLOR 4,10,10,10           ! hellgrau
  226.   SETCOLOR 5,0,0,15             ! blau
  227.   SETCOLOR 6,15,15,0            ! gelb
  228.   SETCOLOR 7,0,0,0              ! schwarz erhalten
  229. RETURN
  230. PROCEDURE frage.stellen         ! Fragebogen
  231.   fraz%=fraz%+1                 ! Zähler für die gestellten Fragen plus 1
  232.   berechnung%=0                 ! Berechnungsflag zurücksetzen
  233.   FOR j%=1 TO 3
  234.     aw%(j%)=0                   ! Flags der Antworten löschen
  235.     g%(j%)=1                    ! Flags der gedrückten Tasten setzen
  236.   NEXT j%
  237.   programmkopf
  238.   COLOR 2                       ! schwarze Farbe
  239.   PBOX 1,22,639,58              ! Fragenbox
  240.   COLOR 0                       ! graue Farbe
  241.   PBOX 7,25,633,55              ! Fragenbox
  242.   COLOR 4                       ! hellgraue Farbe
  243.   LINE 7,25,7,54                ! Linien für 3D-Effekt
  244.   LINE 7,25,631,25
  245.   LINE 11,54,631,54
  246.   LINE 631,26,631,53
  247.   COLOR 2                       ! schwarze Farbe
  248.   LINE 11,27,11,53              ! senkrechter Strich (links)
  249.   LINE 12,27,12,53              ! senkrechter Strich (links)
  250.   LINE 11,27,627,27             ! waagerechter Strich (oben)
  251.   PCOLOR 6
  252.   PRINT AT(10,2);"F  R  A  G  E  B  O  G  E  N"
  253.   COLOR 7                        ! schwarze Farbe
  254.   PBOX 14,61,56,83               ! 1. Auswahlbox
  255.   PBOX 14,85,56,107              ! 2. Auswahlbox
  256.   PBOX 14,109,56,131             ! 3. Auswahlbox
  257.   PBOX 14,181,56,203             ! Bestätigungsbox
  258.   COLOR 4
  259.   PBOX 18,63,52,81               ! 1. Auswahlbox
  260.   PBOX 18,87,52,105              ! 2. Auswahlbox
  261.   PBOX 18,111,52,129             ! 3. Auswahlbox
  262.   PBOX 18,183,52,201             ! Bestätigungsbox
  263.   COLOR 0
  264.   PBOX 20,64,50,80               ! 1. Auswahlbox
  265.   PBOX 20,88,50,104              ! 2. Auswahlbox
  266.   PBOX 20,112,50,128             ! 3. Auswahlbox
  267.   PBOX 20,184,50,200             ! Bestätigungsbox
  268.   PCOLOR 3
  269.   PRINT AT(13,28);"Fehlerhafte Antworten werden in roter Schrift angegeben."
  270.   PCOLOR 6
  271.   PRINT AT(10,25);"Eingabe (Antworten) auswerten"
  272.   PRINT AT(4,31);"Erreichte Fehlerpunkte: ";
  273.   PCOLOR 3
  274.   PRINT fehlerpunkte%
  275.   PCOLOR 6
  276.   PRINT AT(33,31);"Mögliche Fehlerpunkte bei dieser Frage: ";
  277.   PCOLOR 1
  278.   PRINT fehler%
  279.   PCOLOR 6
  280.   PRINT AT(45,2);"Frage Nummer: ";
  281.   PRINT fraz%;                  ! Nummer der Frage anzeigen
  282.   PRINT "   gesamt: ";n%
  283.   COLOR 6,0
  284.   satz.lesen                    ! Frage aus der Datei lesen
  285.   FOR j%=0 TO 2                 ! Fragen ausgeben
  286.     anw$(j%)=te$(j%+1)
  287.     '    TEXT 32,j%*8+4.5*8,anw$(j%)
  288.     TEXT 20,j%*8+4.5*8,anw$(j%)
  289.   NEXT j%
  290.   PCOLOR 1,0                    ! weiße Schrift
  291.   FOR j%=0 TO 5
  292.     anw$(j%)=te$(j%+4)          ! Antworten merken
  293.   NEXT j%
  294.   PRINT AT(10,9);anw$(0)        ! mögliche Antworten ausgeben
  295.   PRINT AT(10,10);anw$(1)
  296.   PRINT AT(10,12);anw$(2)
  297.   PRINT AT(10,13);anw$(3)
  298.   PRINT AT(10,15);anw$(4)
  299.   PRINT AT(10,16);anw$(5)
  300.   FOR j%=1 TO 3                 ! Fragen ausgeben
  301.     zahl%(j%)=VAL(te$(j%+9))
  302.   NEXT j%
  303.   fehler%=VAL(te$(13))
  304. RETURN
  305. PROCEDURE index.pos             ! Feldposition feststellen
  306.   po%(1)=1
  307.   FOR j%=1 TO be%               ! Bildschirmpos. der Datenfelder berechnen
  308.     po%(j%+1)=po%(j%)+td%(j%)
  309.   NEXT j%
  310. RETURN
  311. PROCEDURE info
  312.   programmkopf
  313.   PCOLOR 6,0
  314.   PRINT AT(20,2);"V e r k e h r s t e s t   Version 1.00"
  315.   PCOLOR 1,0
  316.   PRINT AT(1,7);"Ein Programm zur Vorbereitung auf die theoretische Fahrprüfung."
  317.   PRINT AT(1,9);"Eine Gewähr für die Richtigkeit der Fragen und Antworten kann nicht"
  318.   PRINT AT(1,11);"übernommen werden"
  319.   PRINT AT(1,13);"Es sind zur Zeit nur die Textfragen enthalten."
  320.   PRINT AT(1,15);"Dieses Programm kann und soll keine Fahrschulbücher ersetzen."
  321.   PRINT AT(1,25);"Dieses Programm darf kopiert und in jede PD-Serie übernommen werden."
  322.   PCOLOR 5,0
  323.   PRINT AT(10,31);"© 31.08.1991 by Henry König, Bornheide 71, 2000 Hamburg 53"
  324.   tastendruck
  325. RETURN
  326. PROCEDURE init                  ! Variable initialisieren
  327.   OPENS 1,0,0,640,256,3,&H8000
  328.   OPENW #1,0,0,640,256,&H18,&H1800,1
  329.   RANDOMIZE TIMER               ! Zufallgenerator starten
  330.   farben.setzen
  331.   info                          ! Info über das Programm ausgeben
  332.   n%=400                        ! Anzahl der Fragen und Antworten 1
  333.   ON ERROR GOSUB fehler
  334.   MODE 0
  335.   CLR x2%
  336.   un%=11                        ! Anzahl der Datenpflegemenüs
  337.   at%=36                        ! Anzahl der Anweisungen
  338.   ez%=21                        ! Zeilenanzahl der Bildschirmmaske
  339.   fz%=21                        ! Anz. Datenfelder
  340.   DIM frage$(2,n%)              ! Speicher fur die Fragen
  341.   DIM anw$(5)                   ! Speicher fur die Antworten
  342.   DIM zahl%(3)                  ! 1= ja, 0=nein
  343.   DIM g%(3)                     ! Flag fur gewählte Antwortbox
  344.   DIM aw%(3)                    ! Flags für die Auswertung
  345.   DIM hilf%(n%)
  346.   '
  347.   DIM m$(ez%)                   ! Bildschirmmaske
  348.   DIM mx%(ez%),my%(ez%)         ! Zeilen und Spalten der Datenfelder (Maske)
  349.   DIM ax%(at%),ay%(at%),aw$(at%)! Anweisungstexte und Position
  350.   DIM pfad$(3),d$(3),maske$(3)  ! Pfadnamen und Dateinamen
  351.   DIM te$(fz%),td$(fz%),td%(fz%)! Feldinhalt, Datenfeldname und Datenfeldlänge
  352.   DIM po%(fz%)
  353.   FOR j%=0 TO at%
  354.     READ ax%(j%),ay%(j%),aw$(j%),dummy%
  355.   NEXT j%
  356.   maske.einlesen
  357.   IF abbruch%=1 THEN
  358.     beenden
  359.   ELSE
  360.     ini                         !
  361.   ENDIF
  362. RETURN
  363. PROCEDURE ini                   ! 1. Frage stellen
  364.   oeffne.i                      ! Dateigröße feststellen
  365.   i%=n%
  366.   oeffne.r                      ! Relative Datei öffnen
  367.   CLR fehlerpunkte%             ! Fehlerpunkte löschen
  368.   z%=1+RAND(n%)                 ! Nummer der Frage per Zufall bestimmen
  369.   '  z%=INT(RND*(i%-1))            ! Nummer der Frage per Zufall bestimmen
  370.   CLR fraz%                     ! Fragenzähler zurücksetzen
  371.   frage.stellen                 ! 1. Frage stellen
  372. RETURN
  373. PROCEDURE maske.einlesen        ! Maske vom Datenträger lesen
  374.   programmkopf
  375.   anweisung(21)                 ! Namen der Arbeitsdatei
  376.   anweisung(33)                 ! Ordner sind mit...
  377.   programmname
  378.   IF abbruch%=0 THEN
  379.     OPEN "i",#1,pfad$(x2%)+maske$(x2%)
  380.     INPUT #1,ms%,be%,le%,dl%,dz%
  381.     FOR j%=1 TO ez%
  382.       LINE INPUT #1,m$(j%)
  383.       INPUT #1,mx%(j%),my%(j%)
  384.     NEXT j%
  385.     FOR j%=1 TO fz%
  386.       LINE INPUT #1,x$
  387.       LINE INPUT #1,x$
  388.       LINE INPUT #1,x$
  389.       INPUT #1,td%(j%)
  390.     NEXT j%
  391.     CLOSE #1                    ! Datei wieder schließen
  392.     index.pos                   ! Feldposition berechnen
  393.   ENDIF
  394. RETURN
  395. PROCEDURE mauskontrolle         ! Mauskontrolle für den Fragebogen
  396.   IF arbeit%=0 THEN             !
  397.     CLR x%                      ! Mausposition löschen
  398.     CLR y%
  399.     IF MENU(2)=&H68 THEN        ! linke Maustaste gedrückt?
  400.       MOUSE x%,y%,mausk%        ! ja, dann Position merken
  401.       IF x%>125 AND x%<145 THEN   ! Box für neuen Test gewählt
  402.         IF y%>140 AND y%<155 THEN
  403.           test.starten            ! ja, dann neuen Test starten
  404.         ELSE IF y%>165 AND y%<180
  405.           beenden                 ! nein, dann Programm beenden
  406.         ENDIF
  407.       ENDIF
  408.       IF x%>20 AND x%<50 THEN     ! Antwortboxen gewählt
  409.         IF y%>64 AND y%<80 THEN   ! 1. Antwortbox gewählt
  410.           IF g%(1)=1 THEN         ! Feld schon angekreuzt?
  411.             aw%(1)=1
  412.             g%(1)=0
  413.             COLOR 5
  414.             LINE 20,64,50,80      ! Feld ankreuzen
  415.             LINE 50,64,20,80
  416.           ELSE                    ! Feld ist angekreuzt
  417.             aw%(1)=0
  418.             g%(1)=1
  419.             COLOR 0
  420.             PBOX 21,65,49,79      ! Kreuz entfernen
  421.           ENDIF
  422.         ELSE IF y%>88 AND y%<104  ! 2. Antwortbox gewählt
  423.           IF g%(2)=1 THEN
  424.             aw%(2)=1
  425.             g%(2)=0
  426.             COLOR 5
  427.             LINE 20,88,50,104     ! 2. Box ankreuzen
  428.             LINE 50,88,20,104
  429.           ELSE                    ! 2. Antwortbox war schon angekreuzt
  430.             aw%(2)=0
  431.             g%(2)=1
  432.             COLOR 0
  433.             PBOX 21,89,49,103     ! Kreuz löschen
  434.           ENDIF
  435.         ELSE IF y%>112 AND y%<128 ! 3. Antwortbox gewählt
  436.           IF g%(3)=1 THEN
  437.             aw%(3)=1
  438.             g%(3)=0
  439.             COLOR 5
  440.             LINE 20,112,50,128    ! Box ankreuzen
  441.             LINE 50,112,20,128
  442.           ELSE                    ! 3. Antwortbox war angekreuzt
  443.             aw%(3)=0
  444.             g%(3)=1
  445.             COLOR 0
  446.             PBOX 21,113,49,127    ! Kreuz entfernen
  447.           ENDIF
  448.         ELSE IF y%>184 AND y%<200 ! Antwort auswerten
  449.           SOUND 661.63,2,255      ! Klick
  450.           auswertung              ! Antworten auswerten
  451.         ELSE
  452.           ' hier eine WEITERBOX einfügen
  453.           CLR x%                  ! Mausposition löschen, damit ein Unterprog.
  454.           CLR y%                  ! nicht zweimal ausgeführt wird
  455.         ENDIF
  456.       ENDIF
  457.     ENDIF
  458.   ENDIF
  459. RETURN
  460. PROCEDURE oeffne.i              ! Dateigröße feststellen
  461.   OPEN "I",#1,pfad$(x2%)+d$(x2%)
  462.   lo%=LOF(#1)                   ! Dateigröße
  463.   n%=lo%/le%                    ! Anzahl der gespeicherten Datensätze
  464.   CLOSE #1                      ! Datei schließen
  465. RETURN
  466. PROCEDURE oeffne.r              ! Relative Datei öffnen
  467.   OPEN "R",#1,pfad$(x2%)+d$(x2%),le%
  468.   FIELD #1,(le%) AS record$
  469. RETURN
  470. PROCEDURE programmkopf
  471.   CLS
  472.   COLOR 2                       ! schwarze Box
  473.   PBOX 1,1,639,20
  474.   COLOR 0                       ! grau
  475.   PBOX 6,4,633,17
  476.   COLOR 4                       ! hellgrau
  477.   LINE 6,4,633,4
  478.   LINE 6,4,6,17
  479.   PRINT AT(2,2);SPACE$(78)
  480.   PCOLOR 6,0
  481.   PCOLOR 1,0
  482.   programmfuss
  483. RETURN
  484. PROCEDURE programmfuss          ! Anweisungsboxen zeichnen
  485.   COLOR 2                       ! schwarz
  486.   PBOX 1,(27*8)-10,639,(32*8)   ! schwarze Box
  487.   COLOR 0                       ! grau
  488.   PBOX 6,(27*8)-7,633,(28*8)+4  ! graue Box
  489.   PBOX 6,(29*8)+2,633,(32*8)-4  ! 2. graue Box
  490.   COLOR 4                       ! hellgrau
  491.   BOX 7,(27*8)-7,633,(32*8)-3
  492.   LINE 7,(29*8)+2,633,(29*8)+2
  493.   LINE 16,(29*8)-6,639-16,(29*8)-6
  494.   LINE 16,(29*8)+5,639-16,(29*8)+5
  495.   LINE 639-16,(29*8)-6,639-16,(26*8)+4  ! senkrechter Strich
  496.   LINE 16,(29*8)+5,16,(31*8)+2  ! senkrechter Strich
  497.   COLOR 2                       ! schwarz
  498.   LINE 7,(32*8)-3,633,(32*8)-3  ! schwarze Linie
  499.   LINE 633,(27*8)-7,633,(32*8)-3
  500.   LINE 16,(27*8)-4,639-16,(27*8)-4
  501.   LINE 16,(31*8)+2,639-16,(31*8)+2
  502.   LINE 16,(29*8)-6,16,(26*8)+4  ! senkrechter Strich
  503.   LINE 639-16,(29*8)+5,639-16,(31*8)+2    ! senkrechter Strich
  504. RETURN
  505. PROCEDURE programmauswahl(titel$,oktext$,VAR pfad$,dateiname$)
  506.   FILESELECT titel$,oktext$,pfad$,dateiname$
  507.   pos1%=RINSTR(dateiname$,"/")
  508.   pos2%=RINSTR(dateiname$,":")
  509.   IF pos1%>0 THEN               ! Dateipfad herausfiltern
  510.     pfad$=MID$(dateiname$,1,pos1%)
  511.     dateiname$=MID$(dateiname$,pos1%+1)
  512.   ELSE IF pos2%>1 AND pos1%=0   ! Laufwerk nach Drive$()
  513.     pfad$=LEFT$(dateiname$,pos2%)
  514.     dateiname$=MID$(dateiname$,pos2%+1)
  515.   ENDIF
  516. RETURN
  517. PROCEDURE programmname
  518.   pfad$=pfad$(x2%)              ! Pfad übergeben für Fileselect
  519.   IF pfad$="" THEN
  520.     pfad$=DIR$(0)               ! aktuelles Laufwerk übernehmen
  521.   ENDIF
  522.   programmauswahl("Datei auswählen","OK",pfad$,dateiname$)
  523.   IF dateiname$="" THEN
  524.     abbruch%=1                  ! Abbruchflag setzen
  525.   ELSE
  526.     CLR abbruch%                ! Abbruchflag löschen
  527.     x$=UPPER$(RIGHT$(dateiname$,6))
  528.     IF x$=".DATEN" OR x$=".MASKE" THEN
  529.       dateiname$=LEFT$(dateiname$,LEN(dateiname$)-6)
  530.     ENDIF
  531.     d$(x2%)=dateiname$+".Daten" ! Datenbankname
  532.     maske$(x2%)=dateiname$+".Maske"! Name der Konfigurationsdatei
  533.   ENDIF
  534.   pfad$(x2%)=pfad$              ! Pfad sichern für nächstes Fileselect
  535. RETURN
  536. PROCEDURE maustaste             ! ein Zeichen von der Tastatur holen
  537.   arbeit%=1                     ! Mauskontrolle verhindern
  538.   CLR x%                        ! Steuerzeichen löschen
  539.   CLR y%
  540.   WHILE x%<51 OR MOUSEK=0
  541.     x$=INKEY$                   ! Zeichen von Tastatur
  542.     IF MOUSEK<>0 THEN             ! linke Maustaste
  543.       MOUSE x%,y%,mausk%               ! Maustaste
  544.     ENDIF
  545.   WEND
  546.   arbeit%=0                     ! Mauskontrolle wieder einschalten
  547. RETURN
  548. PROCEDURE satz.lesen            ! einen Datensatz lesen
  549.   rn%=z%                        ! Recordnummer
  550.   GET #1,rn%                    ! Satz lesen
  551.   FOR j1%=1 TO be%
  552.     te$(j1%)=MID$(record$,po%(j1%),td%(j1%))
  553.   NEXT j1%
  554. RETURN
  555. PROCEDURE taste                 ! ein Zeichen von der Tastatur holen
  556.   CLR x%                        ! Steuerzeichen löschen
  557.   CLR mausk%
  558.   CLR mausx%                    ! Mausspalte löschen
  559.   CLR mausy%                    ! Mauszeile löschen
  560.   WHILE x%=0 AND MOUSEK=0
  561.     x$=INKEY$                   ! Zeichen von Tastatur
  562.     x%=ASC(x$)                  ! ASCII-Wert für Auswertung
  563.   WEND
  564.   IF MOUSEK<>0 THEN             ! linke Maustaste
  565.     mausx%=INT(MOUSEX/8)+1      ! ja, dann Spalte = mausx
  566.     mausy%=INT(MOUSEY/8)+1      ! Zeile = mausy
  567.     mausk%=MOUSEK               ! Maustaste
  568.   ENDIF
  569. RETURN
  570. PROCEDURE tastendruck
  571.   PRINT AT(4,28);SPACE$(74);
  572.   PCOLOR 3,0
  573.   PRINT AT(16,28);"Weiter mit beliebiger Taste oder Mausklick."
  574.   maustaste                     ! auf Taste oder Mausklick warten
  575.   PCOLOR 1,0
  576.   PRINT AT(4,28);SPACE$(74)
  577. RETURN
  578. PROCEDURE tastendruck1
  579.   PRINT AT(4,28);SPACE$(74);
  580.   PCOLOR 3,0
  581.   PRINT AT(16,28);"Nächste Frage mit beliebiger Taste oder Mausklick."
  582.   maustaste                     ! auf Taste oder Mausklick warten
  583.   PCOLOR 1,0
  584.   PRINT AT(4,28);SPACE$(74)
  585. RETURN
  586. PROCEDURE testergebniss         ! Testergebnis ausgeben
  587.   CLOSE                         ! alle offenen Dateien schließen
  588.   programmkopf
  589.   PCOLOR 6
  590.   PRINT AT(3,2);"A U S W E R T U N G   D E R   A N T W O R T E N   I M   F R A G E B O G E N"
  591.   PRINT AT(3,6);"Sie haben ";fraz%;" Fragen beantwortet"
  592.   IF fehlerpunkte%>2 THEN
  593.     PRINT AT(3,8);"Leider haben Sie dabei ";fehlerpunkte%;" Fehlerpunkte erzielt."
  594.   ENDIF
  595.   anweisung(27)
  596.   PCOLOR 3
  597.   IF fehlerpunkte%>8 THEN       ! mehr als 8 Fehlerpunkte
  598.     PRINT AT(3,10);"In einer theoretischen Führerscheinprüfung wären sie damit durchgefallen!"
  599.   ELSE                          ! bis 8 Fehlerpunkte sind erlaubt
  600.     PRINT AT(18,8);"Sie haben diesen Test erfolgreich bestanden!"
  601.     PRINT AT(27,10);"Herzlichen Glückwunsch."
  602.   ENDIF
  603.   PCOLOR 6
  604.   PRINT AT(20,19);"Neuen Test"
  605.   PRINT AT(20,22);"Programm beenden"
  606.   COLOR 1
  607.   BOX 125,140,145,155           ! Abfragebox 'Neuer Test' zeichnen
  608.   BOX 125,165,145,180           ! Abfragebox 'Programm beenden' zeichnen
  609. RETURN
  610. PROCEDURE test.starten          ! Test starten
  611.   ERASE hilfs%()                ! Speicher löschen
  612.   DIM hilfs%(n%)                ! Speicher dimensionieren
  613.   ini                           ! neuen Test starten
  614. RETURN
  615. PROCEDURE textstil(stil%,vfarbe%,hfarbe%)
  616.   par$=STR$(stil%)+";"+STR$(30+vfarbe%)+";"+STR$(40+hfarbe%)
  617.   PRINT CHR$(&H9B);par$;CHR$(&H6D);
  618. RETURN
  619. REM
  620.